Chip 2002 March/Chip_2002-03_cd1.bin/zkuste/delphi/kolekce/d3456/gmprintsuite_eval.exe/{app}/GmOrientationImage.pas

Pascal/Delphi Source File | 2002-01-02 | 8.9 KB | 296 lines

{******************************************************************************}
{                                                                              }
{                         TGmOrientationImage 2.3                             }
{                                                                              }
{           Copyright (c) 2001 Graham Murt  - www.MurtSoft.com                 }
{                                                                              }
{   Feel free to e-mail me with any comments, suggestions, bugs or help at:    }
{                                                                              }
{                           [e-mail]                                }
{                                                                              }
{******************************************************************************}

unit GmOrientationImage;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, GmTypes,
  GmPreview, Buttons, GmConst;

type
  TGmOrientationPage = class(TGmCustomPage)
  private
    FOrientation: TGmOrientation;
    FShowHeaderFooter: Boolean;
    procedure SetOrientation(AOrientation: TGmOrientation);
    procedure DrawHeaderFooter(Canvas: TCanvas; AArea: TRect; Border: integer);
  protected
    procedure Paint; override;
  public
    property Orientation: TGmOrientation read FOrientation write SetOrientation;
  end;

  TGmOrientationImage = class(TWinControl)
  private
    FBtnPortrait: TSpeedButton;
    FBtnLandscape: TSpeedButton;
    FOrientation: TGmOrientation;
    FPreview: TGmPreview;
    FPageImage: TGmOrientationPage;
    FShowButtons: Boolean;
    FShowHeaderFooter: Boolean;
    // events...
    FOnClickPortrait: TNotifyEvent;
    FOnClickLandscape: TNotifyEvent;
    procedure BtnClick(Sender: TObject);
    procedure SetGmPreview(APreview: TGmPreview);
    procedure SetOrientation(AOrientation: TGmOrientation);
    procedure SetShadow(AShadow: TGmShadow);
    procedure SetShowButtons(AValue: Boolean);
    procedure SetShowHeaderFooter(AValue: Boolean);
    function GetShadow: TGmShadow;

    { Private declarations }
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    // update messages...
    procedure OrientationChanged(var Message: TMessage); message GM_ORIENTATION_CHANGED;
    procedure ComponentResize(var Message: TMessage); message WM_SIZE;
    { Protected declarations }
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    { Public declarations }
  published
    property Orientation: TGmOrientation read FOrientation write SetOrientation;
    property Preview: TGmPreview read FPreview write SetGmPreview;
    property ShowHint;
    property Shadow: TGmShadow read GetShadow write SetShadow;
    property ShowButtons: Boolean read FShowButtons write SetShowButtons default True;
    property ShowHeaderFooter: Boolean read FShowHeaderFooter write SetShowHeaderFooter default True;
    property Visible;
    property Color;
    // events
    property OnClickPortrait: TNotifyEvent read FOnClickPortrait write FOnClickPortrait;
    property OnClickLandscape: TNotifyEvent read FOnClickLandscape write FOnClickLandscape;
    { Published declarations }
  end;

//procedure Register;

implementation

{$R OrienRes.RES}

//------------------------------------------------------------------------------

procedure TGmOrientationPage.SetOrientation(AOrientation: TGmOrientation);
var
  TempVal: integer;
begin
  if FOrientation <> AOrientation then
  begin
    FOrientation := AOrientation;
    // resize page...
    TempVal := Width;
    Width := Height;
    Height := TempVal;
    Top := (TWinControl(Owner).Height - Height) div 2;
    Invalidate;
  end;
end;

procedure TGmOrientationPage.DrawHeaderFooter(Canvas: TCanvas; AArea: TRect; Border: integer);
begin
  if FShowHeaderFooter then
  begin
    Canvas.Pen.Color := $00777777;
    Canvas.Polyline([Point(AArea.Left+Border, AArea.Top+Border)   , Point(AArea.Right-Border, AArea.Top+Border)]);
    Canvas.Polyline([Point(AArea.Left+Border, AArea.Bottom-Border), Point(AArea.Right-Border, AArea.Bottom-Border)]);
  end;
end;

procedure TGmOrientationPage.Paint;
var
  AChar: Char;
  TextPos: TPoint;
  PageArea: TRect;
begin
  inherited;
  with Canvas do
  begin
    Pen.Style := psSolid;
    PageArea := Rect(0,0,((Width-Shadow.Width)), ((Height-Shadow.Width)-2));
    DrawHeaderFooter(Canvas, PageArea, 6);
    Font.Name := 'Times New Roman';
    Font.Size := 16;
    Font.Color := clSilver;
    Brush.Style := bsClear;
    if FOrientation = gmPortrait then AChar := 'P' else AChar := 'L';
    TextPos.x := (Width - TextWidth(AChar)) div 2;
    TextPos.y := (Height - TextHeight(AChar)) div 2;
    TextOut(TextPos.x, TextPos.y ,AChar);
  end;
end;

//------------------------------------------------------------------------------


constructor TGmOrientationImage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Width := 105;
  Height := 65;
  FPageImage := TGmOrientationPage.Create(Self);
  FPageImage.FShowHeaderFooter := True;
  FShowHeaderFooter := True;
  with FPageImage do
  begin
    Left := 40;
    Width := 45;
    Height := 60;
    Shadow.Width := 2;
    Parent := Self;
  end;
  FShowButtons := False;
  Orientation := gmPortrait;
  SetShowButtons(True);
end;

destructor TGmOrientationImage.Destroy;
begin
  if Assigned(FPreview) then FPreview.RemoveAssociatedComponent(Self);
  if Assigned(FBtnPortrait) then FBtnPortrait.Free;
  if Assigned(FBtnLandscape) then FBtnLandscape.Free;
  FPageImage.Free;
  inherited Destroy;
end;

procedure TGmOrientationImage.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = FPreview) then
    FPreview := nil;
end;

procedure TGmOrientationImage.OrientationChanged(var Message: TMessage);
begin
  if Orientation <> FPreview.Orientation then
    Orientation := FPreview.Orientation;
end;

procedure TGmOrientationImage.ComponentResize(var Message: TMessage);
begin
  Width := 105;
  Height := 65;
end;

procedure TGmOrientationImage.BtnClick(Sender: TObject);
begin
  if (Sender = FBtnPortrait) and (Orientation <> gmPortrait) then
  begin
    Orientation := gmPortrait;
    if Assigned(FOnClickPortrait) then FOnClickPortrait(Self);
  end
  else
  if (Sender = FBtnLandscape) and  (Orientation <> gmLandscape) then
  begin
    Orientation := gmLandscape;
    if Assigned(FOnClickLandscape) then FOnClickLandscape(Self);
  end;
end;

procedure TGmOrientationImage.SetGmPreview(APreview: TGmPreview);
begin
  if Assigned(APreview) then
  begin
    FPreview := APreview;
    FPreview.AddAssociatedComponent(Self);
    //SendMessage(FPreview.Handle, GM_REGISTER_COMPONENT, Handle, 0);
    Orientation := FPreview.Orientation;
  end
  else
    FPreview := nil;
end;

procedure TGmOrientationImage.SetOrientation(AOrientation: TGmOrientation);
begin
  FOrientation := AOrientation;
  FPageImage.Orientation := AOrientation;
  // select the correct button...
  if FShowButtons then
  begin
    FBtnPortrait.Down := AOrientation = gmPortrait;
    FBtnLandscape.Down := AOrientation = gmLandscape;
  end;
  if Assigned(FPreview) then FPreview.Orientation := AOrientation;
  Invalidate;
end;

procedure TGmOrientationImage.SetShadow(AShadow: TGmShadow);
begin
  FPageImage.Shadow := AShadow;
  FPageImage.Invalidate;
end;

procedure TGmOrientationImage.SetShowButtons(AValue: Boolean);
begin
  if FShowButtons <> AValue then
  begin
    if AValue = True then
    begin
      FPageImage.Left := 40;
      FBtnPortrait := TSpeedButton.Create(Self);
      with FBtnPortrait do
      begin
        Top := 6;
        Left := 8;
        Glyph.LoadFromResourceName(HInstance, 'BTNPORT');
        GroupIndex := 1;
        Down := True;
        OnClick := BtnClick;
      end;
      FBtnLandscape := TSpeedButton.Create(Self);
      with FBtnLandscape do
      begin
        Top := 34;
        Left := 8;
        Glyph.LoadFromResourceName(HInstance, 'BTNLAND');
        GroupIndex := 1;
        OnClick := BtnClick;
      end;
      FBtnPortrait.Parent := Self;
      FBtnLandscape.Parent := Self;
    end
    else
    begin
      FPageImage.Left := 4;
      FBtnPortrait.Free;
      FBtnLandscape.Free;
      FBtnPortrait := nil;
      FBtnLandscape := nil;
    end;
    FShowButtons := AValue;
  end;
end;

procedure TGmOrientationImage.SetShowHeaderFooter(AValue: Boolean);
begin
  FShowHeaderFooter := AValue;
  FPageImage.FShowHeaderFooter := AValue;
  FPageImage.Repaint;
end;

function TGmOrientationImage.GetShadow: TGmShadow;
begin
  Result := FPageImage.Shadow;
end;

{procedure Register;
begin
  RegisterComponents('GmPrintSuite', [TGmOrientationImage]);
end; }

end.